COMMENT ⊗   VALID 00009 PAGES 
RECORD PAGE   DESCRIPTION
 00001 00001
 00002 00002	TITLE EULER  -  EULER SURFACE SUBROUTINES  -  JULY 1972.
 00003 00003	SUBR(INVERT)	AC-TRANSPARENT.
 00004 00004	SUBR(MKEV)
 00006 00005	ENEW ← MKFE(V1,F,V2)		"J" COMMAND.
 00008 00006	CDR V2'S TAIL REPLACING +F WITH FNEW.
 00009 00007	VNEW ← ESPLIT(E)		"M" COMMAND.
 00011 00008	E ← KLEV(VNEW)		"K" COMMAND.
 00013 00009	F ← KLFE(ENEW)		"K" COMMAND.
 00016 ENDMK
⊗;
TITLE EULER  -  EULER SURFACE SUBROUTINES  -  JULY 1972.
COMMENT /
...after Leonhard Euler,1707-1783, Swiss mathematician.
	VNEW ← MKEV(F,V);	"E" COMMAND.
	ENEW ← MKFE(V1,F,V2);	"J" COMMAND.
	VNEW ← ESPLIT(E);	"M" COMMAND.
	   E ← KLEV(VNEW);	"K" COMMAND.
	   F ← KLFE(ENEW);	"K" COMMAND.
	INVERT(E);
/

EXTERN GETBLK,RELBLK
EXTERN MKB,MKF,MKE,MKV,MKBFV
EXTERN KLB,KLF,KLE,KLV
EXTERN NCW.,PCW.,NCCW.,PCCW.
EXTERN ECW,ECW.,ECCW,ECCW.,OTHER,OTHER.
EXTERN BODY,FCW,FCCW,VCW,VCCW
SUBR(INVERT)	;AC-TRANSPARENT.
BEGIN	INVERT
	E←1
	DAC E,SAV#
	LAC E,ARG1
	FOR I⊂(1,3,4,5) {MOVSS I(E)↔}
	FOR I⊂(-3,-2,-1){MOVNS I(E)↔}
	LAC E,SAV
	RET1
BEND

;EVERT(B) - TO TURN INSIDE OUT.
SUBR(EVERT)
BEGIN EVERT
	ACCUMULATORS{B,E}
	CDR B,ARG1
	TEST B,BBIT↔RET1
	LAC E,B
L1:	PED E,E
	TEST E,EBIT↔GO L2
	MOVSS 1(E)
	MOVS  4(E)↔MOVS 1,5(E)
	DAC 1,4(E)↔DAC 5(E)
	GO L1
;...AND ALL THE PARTS OF THIS BODY.
L2:	PART 0,B↔JUMPL .+5
	PUSH P,B↔PUSH P,0↔PUSHJ P,EVERT↔POP P,B
	CDR (P)↔CAIE .-2↔RET1
	COPART B,B↔SKIPL E,B↔GO L1↔RET1
BEND
SUBR(MKEV)
BEGIN	MKEV
	ACCUMULATORS {VNEW,B,F,V,ENEW,E1,E2}
;CHECK FOR BAD ARGUMENTS.
	CDR VNEW,ARG1;FOR BAD RETURNS.
	LAC V,ARG1↔TEST(V,VBIT)↔RET2
	LAC F,ARG2↔TEST(F,FBIT)↔RET2
	NCNT 0,F↔SOSGE↔NCNT. 0,F;WIRE SWEEPING.
;CREATE A NEW EDGE AND VERTEX.
	SETQ(B,{BODY,V})
	SETQ(VNEW,{MKV,B})
	FOR @$ Qε{XYZ}{LAC Q$WC(V)↔DAC Q$WC(VNEW)↔}
	SETQ(ENEW,{MKE,B})
;MAKE FACE AND VERTEX LINKS.
	PED. 	ENEW,VNEW
	NFACE.	F,ENEW
	PFACE.	F,ENEW
	NVT.	VNEW,ENEW
	PVT.	V,ENEW
;CHECK FOR VERTEX BODY CASE.
	PED E1,F↔JUMPE E1,[
	PED. ENEW,F↔PED. ENEW,V
	CALL PCW.,ENEW,ENEW↔CALL NCCW.,ENEW,ENEW↔GO .+1]
;LOWER WINGS POINT AT SELF.
	CALL NCW.,ENEW,ENEW
	CALL PCCW.,ENEW,ENEW
;GET THE UPPER WINGS.
	PED E1,V↔LAC E2,E1
	NFACE 0,E1↔PFACE 1,E1
	CAMN 0,1↔GO L2
L1:	LAC E1,E2
	SETQ(E2,{ECW,E1,V})
	CALL FCW,E1,V
	CAME 1,F↔GO L1
;TIE ENEW TO ITS UPPER WINGS.
L2:	CALL PCW.,E1,ENEW
	CALL NCCW.,E2,ENEW
	RET2(VNEW)
BEND
;ENEW ← MKFE(V1,F,V2);		"J" COMMAND.
SUBR(MKFE)
BEGIN	MKFE
	ACCUMULATORS{V1,F,V2,FNEW,ENEW,E,E0,B,S12,N}

;FETCH THE ARGUMENTS.
	CDR V1,ARG3
	CDR  F,ARG2
	CDR V2,ARG1

;THE CREATIONS.
	SETQ(B,{BODY,F})
	SETQ(FNEW,{MKF,B})
	SETQ(ENEW,{MKE,B})

;SET F'S CNT POSITIVE WHEN NECESSARY.
	NCNT 0,F↔JUMPG .+5
	SOS↔MOVMS↔NCNT. 0,F↔NCNT. 0,FNEW

;LINK ENEW.
	PED. ENEW,F↔	PED. ENEW,FNEW
	PFACE. F,ENEW↔	NFACE. FNEW,ENEW
	PVT. V1,ENEW↔ 	NVT. V2,ENEW

;GET THE UPPER WINGS.
	PED E,V1↔LAC E0,E↔MOVS 1(E)↔CAME 1(E)
	GO[L1: LAC E0,E↔ SETQ(E,{ECW,E0,V1})
	CALL FCW,E0,V1↔CAME 1,F↔GO L1↔GO .+1]
	DAC E0,E1#↔DAC E,E2#

;GET THE LOWER WINGS.
	PED E,V2↔LAC E0,E↔MOVS 1(E)↔CAME 1(E)
	GO[L2: LAC E0,E↔ SETQ(E,{ECW,E0,V2})
	CALL FCW,E0,V2↔CAME 1,F↔GO L2↔GO .+1]
	DAC E0,E3#↔DAC E,E4#
;CDR V2'S TAIL REPLACING +F WITH FNEW.
	LIMZ N,1;PERIMETER COUNTER.
	LAC E,E3
L3:	PFACE 0,E
	NFACE 1,E
	CAME 1↔GO L4
	PFACE. FNEW,E
	AOS N
	PCW E,E
	GO L3

;CCW FROM V1 REPLACING F WITH FNEW.
L4:	LAC E0,E
	LAC E,E2
	CAMN E0,E2↔GO L6
L5:	NFACE 0,E
	CAME F,0
	GO[PFACE. FNEW,E↔GO .+2]
	   NFACE. FNEW,E
	AOS N
	CAME E,E0
	GO[SETQ(E,{ECCW,E,FNEW})↔GO L5]

;LINK THE WINGS.
L6:	CALL PCW.,E1,ENEW
	CALL NCCW.,E2,ENEW
	CALL NCW.,E3,ENEW
	CALL PCCW.,E4,ENEW

;UPDATE PERIMETER COUNTS WHEN NECESSARY.
	NCNT 0,FNEW
	JUMPN 0,L7
	NCNT. N,FNEW
	NCNT 0,F
	SUB  0,N
	ADDI 2
	NCNT. 0,F

L7:	RET3(ENEW)
	LIT
BEND
;VNEW ← ESPLIT(E);		"M" COMMAND.
SUBR(ESPLIT)
BEGIN	ESPLIT
	ACCUMULATORS{VNEW,ENEW,B,E,V}
;CHECK FOR BAD ARGUMENTS.
	CDR VNEW,ARG1
	LAC E,VNEW
	TEST E,EBIT↔GO L
	PVT V,E
;CREATE A NEW EDGE AND VERTEX.
	SETQ(B,{BODY,E})
	SETQ(VNEW,{MKV,B})
	SETQ(ENEW,{MKE,B})
	LAC AA(E)↔DAC AA(ENEW)
	LAC BB(E)↔DAC BB(ENEW)
	LAC CC(E)↔DAC CC(ENEW)
	LAC  7(E)↔DAC  7(ENEW)
;UPDATE V'S FIRST PTR WHEN NECESSARY.
	PED 0,V↔CAMN 0,E↔PED. ENEW,V
;PLACE VNEW BETWEEN E AND ENEW.
	PED. ENEW,VNEW
	PVT 0,E↔PVT. 0,ENEW
	PVT. VNEW,E
	NVT. VNEW,ENEW
	PFACE 0,E↔PFACE. 0,ENEW
	NFACE 0,E↔NFACE. 0,ENEW
;NEW UPPER WINGS ARE LIKE THE OLDE;
	PCW 0,E↔CALL PCW.,0,ENEW
	NCCW 0,E↔CALL NCCW.,0,ENEW
;EDGES POINT AT EACH OTHER ACROSS VNEW.
	CALL NCW.,E,ENEW
	CALL PCCW.,E,ENEW
L:	RET1(VNEW)
BEND 
;E ← KLEV(VNEW);		"K" COMMAND.
SUBR(KLEV)
BEGIN	KLEV
	ACCUMULATORS{E,ENEW,V,VNEW,F,B}
	CDR VNEW,ARG1
	PED ENEW,VNEW
	SETQ(E,{ECCW,ENEW,VNEW})
;ORIENT EDGES AS IN MANDALA.
	NVT 0,ENEW↔ CAMN 0,VNEW↔ GO .+3↔ CALL INVERT,ENEW
	PVT 0,E↔    CAMN 0,VNEW↔ GO .+3↔ CALL INVERT,E
;TIE E TO ITS NEW VERTEX.
	PVT V,ENEW↔ PVT. V,E
;MAKE E'S UPPER WINGS LIKE ENEW'S.
	PCW 0,ENEW↔	CALL PCW.,0,E
	NCCW 0,ENEW↔	CALL NCCW.,0,E
;ELIMINATE OCCURENCES OF ENEW IN F & V.
	PED 0,V↔ CAMN 0,ENEW↔ PED. E,V
	PFACE F,E↔ PED 0,F↔ CAMN 0,ENEW↔ PED. E,F
	NFACE F,E↔ PED 0,F↔ CAMN 0,ENEW↔ PED. E,F
;PURGE 'EM.
	PBODY B,ENEW
	CALL KLV,B,VNEW
	CALL KLE,B,ENEW
	RET1(E)
BEND
COMMENT .        \  pvt  /
                  \     /
            nccw   \   /   pcw
                    \ /
                  V  ⊗
                     |
                ENEW |
                     | nvt
                VNEW ⊗
                     | pvt
                   E |
                     |
                     ⊗
                    / \
             ncw   /   \   pccw
                  /     \
                 /  nvt  \.
;F ← KLFE(ENEW);		"K" COMMAND.
SUBR(KLFE)
BEGIN	KLFE
	ACCUMULATORS{F,ENEW,FNEW,V1,V2,E1,E2,E3,E4,S12,E,B}

;GET EVERYTHING.
	CDR ENEW,ARG1
	PFACE F,ENEW↔	NFACE FNEW,ENEW
	PVT V1,ENEW↔	NVT V2,ENEW
;GET THE WINGS.
	PCW  E1,ENEW
	NCCW E2,ENEW
	NCW  E3,ENEW
	PCCW E4,ENEW
;GET RID OF ENEW APPEARANCES IN F & V.
	PED 0,V1↔ CAMN 0,ENEW↔ PED. E1,V1
	PED 0,V2↔ CAMN 0,ENEW↔ PED. E3,V2
	PED 0,F ↔ CAMN 0,ENEW↔ PED. E3,F
;GET RID OF FNEW APPEARANCES
	LAC E,E2
L1:	PFACE 0,E↔CAMN 0,FNEW↔GO[PFACE. F,E↔GO L2]
	NFACE 0,E↔CAMN 0,FNEW↔GO[NFACE. F,E↔GO L2]
	FATAL(KLFE)
L2:	CAME E,E3↔GO[SETQ(E,{ECCW,E,F})↔GO L1]
;LINK WINGS TOGETHER ABOUT F.
	CALL ECCW.,E2,E1,F
	CALL ECCW.,E4,E3,F
;GET RID OF FNEW AND ENEW.
	PBODY B,ENEW
	CALL KLF,B,FNEW
	CALL KLE,B,ENEW
	RET1(F)
BEND
	

END